﻿Option Explicit On
Option Compare Text

' Monitor critical systems
Imports System.Xml
Imports System.Net
Imports System.Net.Mail
Imports System.Threading
Imports System.IO
Imports System.Web
Imports System.Reflection

Module MainMod
  Dim minElapsed As Integer
  Dim alMonitor As ArrayList
  Dim fw As FileSystemWatcher
  Dim runDate As DateTime = Now
  Dim statusMail As String
  Dim attachLog As String
  Dim statusTo As String
  Dim notifyThread As New Thread(AddressOf statusNotify)
  Dim SMTPServer As String

  Sub Main()
    ' setup log
    logInfo.logFileName = Path.Combine(Directory.GetCurrentDirectory, "AppMon" & Now.ToString("yyyyMMdd") & ".log")
    logInfo.WriteLog("AppMon started " & Now)
    ' Load XML parameter file
    loadXML()

    ' Keep an eye on the XML file in case it changes
    fw = New FileSystemWatcher(Directory.GetCurrentDirectory(), "Mon.xml")
    fw.NotifyFilter = NotifyFilters.LastWrite
    AddHandler fw.Changed, AddressOf xmlChanged
    fw.EnableRaisingEvents = True

    ' notify that monitor is still running
    If statusMail = "yes" Then
      notifyThread.Start()
    End If
  End Sub

  Public Sub statusNotify()
    Do While True
      Thread.Sleep(New TimeSpan(1, 0, 0))
      If Now.Subtract(runDate).TotalDays >= 1 Then
        If statusMail = "yes" AndAlso statusTo.Trim.Length > 0 Then
          If attachLog = "yes" Then
            SendMail(statusTo, "App Monitor Alive", "App monitor is running", logInfo.logFileName)
          Else
            SendMail(statusTo, "App Monitor Alive", "App monitor is running")
          End If
        End If
        runDate = Now
        logInfo.logFileName = Path.Combine(Directory.GetCurrentDirectory, "AppMon" & Now.ToString("yyyyMMdd") & ".log")
        logInfo.WriteLog("AppMon Log rollover " & Now)
      End If
    Loop
  End Sub
  Private Sub xmlChanged(ByVal source As Object, ByVal e As FileSystemEventArgs)
    ' stop all threads and reload xml
    For i As Integer = 0 To alMonitor.Count - 1
      DirectCast(alMonitor(i), monitorObject).kill()
    Next
    notifyThread.Abort()
    loadXML()
    If statusMail = "yes" Then
      notifyThread.Start()
    End If
  End Sub

  Private Sub loadXML()
    alMonitor = New ArrayList
    Dim xmld As New XmlDocument
    Dim rnd As New Random(DateTime.Today.Millisecond)
    Try
      ' check if path exists
      If Not File.Exists(Path.Combine(Directory.GetCurrentDirectory(), "Mon.xml")) Then
        logInfo.WriteLog("Can not find parameter file Mon.xml")
        Exit Sub
      End If

      xmld.Load(Path.Combine(Directory.GetCurrentDirectory(), "Mon.xml"))
      ' See if this is a request to stop monitoring
      statusMail = "no"
      If Not xmld.SelectSingleNode("/monitorSet").Attributes("stopMonitoring") Is Nothing AndAlso _
        xmld.SelectSingleNode("/monitorSet").Attributes("stopMonitoring").Value = "yes" Then
        Exit Sub
      End If
      If xmld.SelectSingleNode("/monitorSet").Attributes("SMTPServer") Is Nothing OrElse _
        xmld.SelectSingleNode("/monitorSet").Attributes("SMTPServer").Value.Trim.Length = 0 Then
        logInfo.WriteLog("SMTP Server not specified in parameter file Mon.xml")
        Exit Sub
      End If
      SMTPServer = xmld.SelectSingleNode("/monitorSet").Attributes("SMTPServer").Value
      If Not xmld.SelectSingleNode("/monitorSet/dailyStatus/sendEmail") Is Nothing Then
        statusMail = xmld.SelectSingleNode("/monitorSet/dailyStatus/sendEmail").InnerText
      End If
      If Not xmld.SelectSingleNode("/monitorSet/dailyStatus/attachLog") Is Nothing Then
        attachLog = xmld.SelectSingleNode("/monitorSet/dailyStatus/attachLog").InnerText
      End If
      If Not xmld.SelectSingleNode("/monitorSet/dailyStatus/emailList") Is Nothing Then
        statusTo = xmld.SelectSingleNode("/monitorSet/dailyStatus/emailList").InnerText
      End If
      ' select all the enabled monitor nodes
      Dim monNodes As XmlNodeList = xmld.SelectNodes("/monitorSet/monitor[@enabled='yes']")
      ' Setup each monitor object
      For Each monNode As XmlNode In monNodes
        alMonitor.Add(New monitorObject(monNode.Attributes("type").Value, _
                                        monNode.Attributes("address").Value, _
                                        monNode.Attributes("port").Value, _
                                        monNode.Attributes("frequency").Value, _
                                        monNode.Attributes("notify").Value, _
                                        monNode.Attributes("subject").Value, _
                                        monNode.Attributes("message").Value, _
                                        monNode.Attributes("outageStart").Value, _
                                        monNode.Attributes("outageEnd").Value, _
                                        monNode.Attributes("enabled").Value, _
                                        monNode.Attributes("responseMustContain").Value, _
                                        monNode.Attributes("responseMaxTime").Value, _
                                        monNode.Attributes("postData").Value, _
                                        monNode.Attributes("logResponse").Value, _
                                        monNode.Attributes("retriesBeforeNotification").Value))
      Next
      For i As Integer = 0 To alMonitor.Count - 1
        DirectCast(alMonitor(i), monitorObject).start()
        ' wait random seconds to start next thread
        Thread.Sleep(rnd.Next(10000, 60000))
      Next
      logInfo.WriteLog(alMonitor.Count & " monitoring threads started.")
      ' just wait for all the child threads
      'Thread.Sleep(Timeout.Infinite)
    Catch ex As Exception

    End Try

  End Sub

  Public Sub SendMail(ByVal sTo As String, ByVal sSubj As String, ByVal sBody As String, _
                      Optional ByVal sAttach As String = "")
    Dim sc As New SmtpClient(SMTPServer)
    Dim m As New MailMessage
    m.Priority = MailPriority.High
    m.From = New MailAddress("oriontechno@gmail.com", "App Monitor")
    m.To.Add(sTo)
    m.Subject = sSubj
    m.Body = sBody
    If sAttach.Trim.Length > 0 AndAlso File.Exists(sAttach) Then
      m.Attachments.Add(New Mail.Attachment(sAttach))
    End If
    sc.Send(m)
  End Sub

  Public Class monitorObject
    Private _type As String
    Private _address As String
    Private _port As String
    Private _frequency As String
    Private _retriesBeforeNotification As String
    Private _notify As String
    Private _subject As String
    Private _message As String
    Private _outageStart As String
    Private _outageEnd As String
    Private _enabled As String
    Private _responseMustContain As String
    Private _responseMaxTime As String
    Private _postData As String
    Private _logResponse As String
    Private retryCount As Integer = 0

    Public Property type() As String
      Get
        Return _type
      End Get
      Set(ByVal value As String)
        _type = value
      End Set
    End Property
    Public Property address() As String
      Get
        Return _address
      End Get
      Set(ByVal value As String)
        _address = value
      End Set
    End Property
    Public Property port() As String
      Get
        Return _port
      End Get
      Set(ByVal value As String)
        _port = value
      End Set
    End Property
    Public Property frequency() As String
      Get
        Return _frequency
      End Get
      Set(ByVal value As String)
        _frequency = value
      End Set
    End Property
    Public Property retriesBeforeNotification() As String
      Get
        Return _retriesBeforeNotification
      End Get
      Set(ByVal value As String)
        _retriesBeforeNotification = value
      End Set
    End Property
    Public Property notify() As String
      Get
        Return _notify
      End Get
      Set(ByVal value As String)
        _notify = value
      End Set
    End Property
    Public Property subject() As String
      Get
        Return _subject
      End Get
      Set(ByVal value As String)
        _subject = value
      End Set
    End Property
    Public Property message() As String
      Get
        Return _message
      End Get
      Set(ByVal value As String)
        _message = value
      End Set
    End Property

    Public Property outageStart() As String
      Get
        Return _outageStart
      End Get
      Set(ByVal value As String)
        _outageStart = value
      End Set
    End Property

    Public Property outageEnd() As String
      Get
        Return _outageEnd
      End Get
      Set(ByVal value As String)
        _outageEnd = value
      End Set
    End Property

    Public Property enabled() As String
      Get
        Return _enabled
      End Get
      Set(ByVal value As String)
        _enabled = value
      End Set
    End Property

    Public Property responseMustContain() As String
      Get
        Return _responseMustContain
      End Get
      Set(ByVal value As String)
        _responseMustContain = value
      End Set
    End Property

    Public Property responseMaxTime() As String
      Get
        Return _responseMaxTime
      End Get
      Set(ByVal value As String)
        _responseMaxTime = value
      End Set
    End Property

    Public Property postData() As String
      Get
        Return _postData
      End Get
      Set(ByVal value As String)
        _postData = value
      End Set
    End Property

    Public Property logResponse() As String
      Get
        Return _logResponse
      End Get
      Set(ByVal value As String)
        _logResponse = value
      End Set
    End Property

    Public Sub New(ByVal sType As String, ByVal sAddress As String, ByVal sPort As String, _
                   ByVal sFrequency As String, ByVal sNotify As String, ByVal sSubject As String, _
                   ByVal sMessage As String, ByVal sOutageStart As String, ByVal sOutageEnd As String, _
                   ByVal sEnabled As String, ByVal sResponseMustContain As String, _
                   ByVal sResponseMaxTime As String, ByVal sPostData As String, _
                   ByVal sLogResponse As String, ByVal sRetriesBeforeNotification As String)
      _type = sType
      _address = sAddress
      _port = sPort
      _frequency = sFrequency
      _notify = sNotify
      _subject = sSubject
      _message = sMessage
      _outageStart = sOutageStart
      _outageEnd = sOutageEnd
      _enabled = sEnabled
      _responseMustContain = sResponseMustContain
      _responseMaxTime = sResponseMaxTime
      _postData = sPostData
      _logResponse = sLogResponse
      _retriesBeforeNotification = sRetriesBeforeNotification
    End Sub

    Private Sub checkAlive()
      ' check if the url or service is alive and record response time
      If _type = "URL" Then
        checkURL()
      Else
        checkService()
      End If
    End Sub

    Private Sub checkURL()
      Dim wc As WebClient
      Dim respStream As Stream
      Dim sResp As String = ""
      Dim checkOK As Boolean = False
      Dim checkErr As String = ""
      Dim startTime As DateTime
      Dim endTime As DateTime
      Dim elapsed As TimeSpan
      Dim iResponseMaxTime As Integer
      Dim iRetriesBeforeNotification As Integer
      Dim dtOutageStart As Nullable(Of DateTime) = Nothing
      Dim dtOutageEnd As Nullable(Of DateTime) = Nothing

      If _outageStart.Trim.Length > 0 Then
        DateTime.TryParse(_outageStart, dtOutageStart)
      End If
      If _outageEnd.Trim.Length > 0 Then
        DateTime.TryParse(_outageEnd, dtOutageEnd)
      End If

      Do While True
        logInfo.WriteLog("Checking " & _type & " " & _address & " at " & Now)
        retryCount += 1
        startTime = Now
        If Not dtOutageStart Is Nothing AndAlso Now >= dtOutageStart AndAlso _
          Not _outageEnd Is Nothing AndAlso Now <= dtOutageEnd Then
          Thread.Sleep(New TimeSpan(0, _frequency, 0))
          Continue Do
        End If
        Try
          wc = New WebClient
          wc.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.0.3705;)")
          sResp = "Empty"
          If _postData.Trim.Length > 0 Then
            wc.Headers.Add("Content-Type", "application/x-www-form-urlencoded")
            Dim bPostData As Byte() = System.Text.Encoding.ASCII.GetBytes(_postData)
            Dim bResp As Byte() = wc.UploadData(_address, "POST", bPostData)
            sResp = System.Text.Encoding.ASCII.GetString(bResp)
          Else
            respStream = wc.OpenRead(_address)
            sResp = (New StreamReader(respStream)).ReadToEnd
          End If
          If _logResponse = "yes" Then
            logInfo.WriteLog(sResp)
          End If
          endTime = Now
          elapsed = endTime.Subtract(startTime)
          If _responseMustContain.Trim.Length > 0 Then
            If sResp.IndexOf(_responseMustContain) >= 0 Then
              checkOK = True
            Else
              checkErr = "Response did not contain text '" & _responseMustContain & "'."
            End If
          Else
            checkOK = True
          End If
          If checkOK Then
            If _responseMaxTime.Trim.Length > 0 AndAlso Integer.TryParse(_responseMaxTime, iResponseMaxTime) Then
              If iResponseMaxTime > elapsed.TotalSeconds Then
                checkOK = False
                checkErr = "Response time exceeded max " & _responseMaxTime & " seconds."
              End If
            End If
          End If
          logInfo.WriteLog("Response for " & _type & " " & _address & " is " & elapsed.TotalSeconds.ToString & " seconds.")
        Catch ex As Exception
          checkOK = False
          checkErr = "Exception: " & ex.Message
        End Try
        If Not checkOK Then
          logInfo.WriteLog(checkErr & " @ " & Now.ToString)
          Integer.TryParse(_retriesBeforeNotification, iRetriesBeforeNotification)
          If retryCount > iRetriesBeforeNotification Then
            SendMail(_notify, _subject, replaceProps(_message).Replace("$response$", sResp))
          End If
        End If
        Thread.Sleep(New TimeSpan(0, _frequency, 0))
      Loop
    End Sub
    Private Sub checkService()
      Dim tc As Sockets.TcpClient
      Dim ns As Sockets.NetworkStream
      Dim sResp As String = ""
      Dim checkOK As Boolean = False
      Dim checkErr As String = ""
      Dim startTime As DateTime
      Dim endTime As DateTime
      Dim elapsed As TimeSpan
      Dim iResponseMaxTime As Integer
      Dim iRetriesBeforeNotification As Integer
      Dim dtOutageStart As Nullable(Of DateTime) = Nothing
      Dim dtOutageEnd As Nullable(Of DateTime) = Nothing

      If _outageStart.Trim.Length > 0 Then
        DateTime.TryParse(_outageStart, dtOutageStart)
      End If
      If _outageEnd.Trim.Length > 0 Then
        DateTime.TryParse(_outageEnd, dtOutageEnd)
      End If

      Do While True
        logInfo.WriteLog("Checking " & _type & " " & _address & " on port " & _port & " at " & Now)
        retryCount += 1
        startTime = Now
        If Not dtOutageStart Is Nothing AndAlso Now >= dtOutageStart AndAlso _
          Not _outageEnd Is Nothing AndAlso Now <= dtOutageEnd Then
          Thread.Sleep(New TimeSpan(0, _frequency, 0))
          Continue Do
        End If
        Try
          tc = New Sockets.TcpClient
          tc.Connect(_address, Integer.Parse(_port))
          ns = tc.GetStream()
          If ns.CanWrite AndAlso _postData.Length > 0 Then
            Dim sendBytes As [Byte]() = System.Text.Encoding.UTF8.GetBytes(_postData)
            ns.Write(sendBytes, 0, sendBytes.Length)
          End If
          If ns.CanRead Then
            ' Reads the NetworkStream into a byte buffer.
            Dim bytes(tc.ReceiveBufferSize) As Byte
            ' Read can return anything from 0 to numBytesToRead. 
            ' This method blocks until at least one byte is read.
            ns.Read(bytes, 0, CInt(tc.ReceiveBufferSize))

            ' Returns the data received from the host to the console.
            sResp = System.Text.Encoding.ASCII.GetString(bytes)
          End If
          endTime = Now
          elapsed = endTime.Subtract(startTime)
          ns.Close()
          tc.Close()
          If _responseMustContain.Trim.Length > 0 Then
            If sResp.IndexOf(_responseMustContain) >= 0 Then
              checkOK = True
            Else
              checkErr = "Response did not contain text '" & _responseMustContain & "'."
            End If
          Else
            checkOK = True
          End If
          If checkOK Then
            If _responseMaxTime.Trim.Length > 0 AndAlso Integer.TryParse(_responseMaxTime, iResponseMaxTime) Then
              If iResponseMaxTime > elapsed.TotalSeconds Then
                checkOK = False
                checkErr = "Response time exceeded max " & _responseMaxTime & " seconds."
              End If
            End If
          End If
        Catch ex As Exception
          checkOK = False
          checkErr = "Exception: " & ex.Message
        End Try
        logInfo.WriteLog("Check completed " & _type & " " & _address & " on port " & _port & " at " & Now)
        If Not checkOK Then
          logInfo.WriteLog(checkErr & " @ " & Now.ToString)
          Integer.TryParse(_retriesBeforeNotification, iRetriesBeforeNotification)
          If retryCount > iRetriesBeforeNotification Then
            SendMail(_notify, _subject, replaceProps(_message))
          End If
        End If
        Thread.Sleep(New TimeSpan(0, _frequency, 0))
      Loop

    End Sub
    Private Function replaceProps(ByVal sTemplate As String) As String
      Dim aryPInfo As PropertyInfo()
      aryPInfo = Me.GetType.GetProperties
      For Each pInfo As PropertyInfo In aryPInfo
        sTemplate = sTemplate.Replace("$" & pInfo.Name & "$", pInfo.GetValue(Me, Nothing))
      Next
      ' Replace special characters
      sTemplate = sTemplate.Replace("\n", vbNewLine).Replace("\t", vbTab)
      Return sTemplate
    End Function
    Protected instThread As New Thread(AddressOf Me.checkAlive)
    Public Sub start()
      If _type = "URL" Then
        logInfo.WriteLog("Thread for monitoring " & _type & " " & _address & " started at " & Now)
      Else
        logInfo.WriteLog("Thread for monitoring " & _type & " " & _address & " on port " & _port & " started at " & Now)
      End If
      instThread.Start()
    End Sub
    Public Sub kill()
      instThread.Abort()
    End Sub
  End Class

End Module
